(** 
    Compact.ml

    Bozman Çagdas <bozman.cagdas@gmail.com> - 2011
    Razakamiadana Tefin <tefy.razaka@gmail.com>   - 2011
*)

open Utils

let push ref_lnk c = ref_lnk := spf "%s%c" !ref_lnk c
  
let format_page str  = 
  let res = ref "" in
  let cpt = ref 0 in
  let dist = ref 1 in
  let i = ref 0 in
  let get_link () =
    let lnk = ref "[[" in
    let nb_space = ref 0 in
    let rec aux () = 
      let c = str.[!i] in      
      let _ =
	incr i;
	push lnk c;
	if c = ']' then 
	  let c = str.[!i] in 
	  let _ = incr i in
	  let _ = 
	    if c = ']' then decr cpt
	    else if c = ' ' then incr nb_space
	  in push lnk c
	else if c = '[' then
	  let c = str.[!i] in
	  let _ = incr i in
	  let _ = 
	    if c = '[' then incr cpt
	    else if c = ' ' then incr nb_space
	  in push lnk c
	else if c = ' ' then incr nb_space
      in
      if !cpt = 0 then let _ = res := spf "%s%s\n" !res !lnk in incr i
      else aux ()
    in
    try 
      aux () 
    with Invalid_argument _ -> 
      if !cpt <> 0 then res := spf "%s%d\n" !res !nb_space
  in
  let format_page_aux () =  
    let rec aux () =  
      let c = str.[!i] 
      in
      incr i;
      if c = '[' then
	let c = str.[!i] in
	let _ = incr i in
	if c = '[' then
	  begin
	    res := spf "%s%d\n" !res !dist;
	    dist := 1;
	    incr cpt;
	    get_link ();
	    aux ()
	  end
	else let _ = if c = ' ' then incr dist in  aux ()
      else
	let _ = if c = ' ' then incr dist in aux ()
    in aux ()
  in
  try
    format_page_aux ()
  with Invalid_argument _ -> !res
    
let is_bad_link lnk = 
  let reg_img = Str.regexp "\\[\\[Image:.*\\]\\]" in
  let reg_fic = Str.regexp "\\[\\[Fichier:.*\\]\\]" in
  (Str.string_match reg_img lnk 0) || (Str.string_match reg_fic lnk 0)
    
let is_link lnk =
  let reg_link = Str.regexp "\\[\\[.*\\]\\]" in
  Str.string_match reg_link lnk 0
    
let check_first l = 
  match l with
    | [] -> l
    | lnk :: ls -> if is_link lnk then l else ls
	
let delete_bad_link l = 
  let rec replace_link accu = function
    | [] -> accu
    | l :: ls ->
      if is_link l then 
	if is_bad_link l then replace_link ("1" :: accu) ls
	else replace_link (l :: accu) ls
      else replace_link (l :: accu) ls
  in
  let dist = ref 0 in
  let rec format_list res = function
    | [] -> res
    | l :: ls ->
      if is_link l then
	let res = (string_of_int !dist) :: res in
	dist := 0;
	format_list (l :: res) ls
      else 
	let _ = dist := !dist + (int_of_string l) in
	format_list res ls 
  in
  let l = replace_link [] l in
  format_list [] l
    
let format_links l = 
  let reg_pipe = Str.regexp "\\[\\[\\(.*\\)|.*\\]\\]" in
  let reg_lnk = Str.regexp "\\[\\[\\(.*\\)\\]\\]"
  in  
  let format_link lnk = 
    if Str.string_match reg_pipe lnk 0 then from_group lnk 1
    else 
      if Str.string_match reg_lnk lnk 0 then from_group lnk 1
      else failwith "Error in format_link"
  in
  let rec aux res = function
    | [] -> res
    | lnk :: ls ->
      let lnk = if is_link lnk then format_link lnk else lnk in
      aux (lnk :: res) ls
  in  
  aux [] l

let compact_req_list reqs =
  let keep_first_req req1 req2 = match req1, req2 with
    | (Ast.L w1, dist1) , (Ast.L w2, dist2) ->
	if (Link.compare w1 w2)
	then (dist1 <= dist2)
	else true
    | (Ast.P w1, dist1) , (Ast.P w2, dist2) ->
	if (Link.compare w1 w2)
	then (dist1 <= dist2)
	else true
    | _,_ -> true
  in	
  let rec compact_aux compact_req reqs = function
    | [] -> compact_req
    | r :: rl ->
	let rec keep_r = function
	  | [] -> true
	  | r' :: rl' ->
	      if keep_first_req r r'
	      then keep_r rl'
	      else false
	in 
	let compact_req = 
	  if (keep_r reqs) 
	  then (r :: compact_req) 
	  else compact_req 
	in
	  compact_aux compact_req reqs rl
  in
  let req_equals req1 req2 = match req1, req2 with
    | (Ast.L w1, dist1) , (Ast.L w2, dist2) ->
	(Link.compare w1 w2) && (dist1 = dist2)
    | (Ast.P w1, dist1) , (Ast.P w2, dist2) ->
	(Link.compare w1 w2) && (dist1 = dist2)
    | _,_ -> false
  in	
  let rec remove_double_req compact_req = function
    | [] -> compact_req
    | r :: rl ->
	let r_in_double =
	  List.fold_left (fun eq req -> eq || (req_equals r req)) false rl
	in
	let compact_req =
	  if r_in_double
	  then compact_req
	  else r :: compact_req
	in
	  remove_double_req compact_req rl
  in
  let compact_req = compact_aux [] reqs reqs in
    remove_double_req [] compact_req
    
let get_struct page  = 
  let regline = Str.regexp "\n" in
  let s = format_page page in
  let l = Str.split regline s in
  let l = delete_bad_link l in
  let l = check_first l in
  let l = format_links l in
    List.rev l
